perm filename ANTS.WEB[304,DEK] blob sn#867492 filedate 1988-12-31 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	% This program by D. E. Knuth is not copyrighted and can be used freely.
C00004 00003	@* Introduction.
C00010 00004	@* Random numbers.
C00013 00005	@* The character set.
C00018 00006	@* Basic input.
C00025 00007	@* Reading the ant data.
C00030 00008	@* The playing field.
C00037 00009	@* Moves.
C00044 00010	@* The main program.
C00047 00011	@* Index.
C00058 ENDMK
C⊗;
% This program by D. E. Knuth is not copyrighted and can be used freely.

% Here is TeX material that gets inserted after \input webmac
\def\title{ANTS}
\magnify{\magstep1}
%\pagewidth=4.2truein % estimate to match CACM line length
\setpage
%\tolerance=1000
\font\tenlogo=logo10 % font used for the METAFONT logo
\def\MF{{\tenlogo META}\-{\tenlogo FONT}}

%\advance\topskip by \baselineskip	% doublespacing
%\advance\smallskipamount by \baselineskip
%\advance\baselineskip by \baselineskip
@* Introduction.
[This short program tries out the specs of the antomata problem. I~haven't
taken time to polish it at all; much of the code isn't really necessary!]

@ Here are some macros I may use for terminal I/O.

@d read_terminal(#)==read(tty,#) {input a value from the terminal}
@d print(#)==write(tty,#) {output to the terminal}
@d print_ln(#)==write_ln(tty,#) {output to the terminal and end the line}

@ Here's an outline of the entire Pascal program:

@p @t\4@>@<Compiler directives@>@/
program ants;
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var@?@<Global variables@>@/
@#
procedure initialize; {this procedure gets things started properly}
	var @!i:integer; {all-purpose index for initialization}
	begin @<Set initial values@>@;
	end;@#
@t\2\4@>@<Random procedures@>@;
@<I/O procedures@>@;
@<Special procedures@>@;
begin initialize; @<The main program@>;
end.

@ Blah blah about constants.

@<Constants in the outer block@>=
buf_size=80; {maximum line length}
max_m=10; {maximum number of rows, plus~1}
max_n=21; {maximum number of columns, plus~1}

@ The only label needed in the main program is |final_end|.

@d final_end=9999 {this label marks the ending of the program}

@<Labels in the out...@>=
final_end;

@ If the first character of a Pascal comment is a dollar sign, the
compiler used here treats the comment as a list of ``compiler directives''
that will affect the translation of this program into machine language.

@<Compiler directives@>=
@{@&$C+,A+,D+@} {yes range check, catch arithmetic overflow, yes debug overhead}

@ We assume that |case| statements may include a
default case that applies if no matching label is found.

@d othercases == others: {default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@f othercases == else
@f endcases == end

@ Labels are given symbolic names by the following definitions, copied from
the program for \TeX. This program doesn't actually use all the conventions
defined here; they are provided just to make changes easier.

@d exit=10 {go here to leave a procedure}
@d restart=20 {go here to start a procedure again}
@d reswitch=21 {go here to start a case statement again}
@d continue=22 {go here to resume a loop}
@d done=30 {go here to exit a loop}
@d done1=31 {like |done|, when there is more than one loop}
@d done2=32 {for exiting the second loop in a long block}
@d done3=33 {for exiting the third loop in a very long block}
@d done4=34 {for exiting the fourth loop in an extremely long block}
@d done5=35 {for exiting the fifth loop in an immense block}
@d done6=36 {for exiting the sixth loop in a block}
@d found=40 {go here when you've found it}
@d found1=41 {like |found|, when there's more than one per routine}
@d found2=42 {like |found|, when there's more than two per routine}
@d not_found=45 {go here when you've found nothing}
@d common_ending=50 {go here when you want to merge with another branch}

@ Here are some macros for common programming idioms.

@d incr(#) == #←#+1 {increase a variable by unity}
@d decr(#) == #←#-1 {decrease a variable by unity}
@d negate(#) == #←-# {change the sign of a variable}
@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
@f loop == xclause
	{\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
@d do_nothing == {empty statement}
@d return == goto exit {terminate a procedure call}
@f return == nil
@* Random numbers.
Here are some procedures for random number generation copied from
\MF\ with minor changes.

There's an auxiliary array |randoms| that contains 55 pseudo-random
fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod \\{rbase}$,
we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
The global variable |j_random| tells which element has most recently
been consumed.

@d rbase==1000000000 {range of random numbers}
@d half_rbase==500000000

@<Glob...@>=
@!randoms:array[0..54] of 0..rbase-1; {the last 55 random values generated}
@!j_random:0..54; {the number of unused |randoms|}

@ To consume a random bit, the program below will say `|if| |random_bit|'.
The following macro is tricky, hence not very robust:

@d random_bit==j_random=0 then new_randoms
	else decr(j_random);
	if randoms[j_random]<half_rbase

@<Random...@>=
procedure new_randoms;
var @!k:0..54; {index into |randoms|}
@!x:integer; {accumulator}
begin for k←0 to 23 do
	begin x←randoms[k]-randoms[k+31];
	if x<0 then x←x+rbase;
	randoms[k]←x;
	end;
for k←24 to 54 do
	begin x←randoms[k]-randoms[k-24];
	if x<0 then x←x+rbase;
	randoms[k]←x;
	end;
j_random←54;
end;

@ To initialize the |randoms| table, we call the following routine.

@<Random...@>=
procedure init_randoms(@!seed:integer);
var @!j,@!jj,@!k:integer; {more or less random integers}
@!i:0..54; {index into |randoms|}
begin j←abs(seed);
while j≥rbase do j←j div 2;
k←1;
for i←0 to 54 do
	begin jj←k; k←j-k; j←jj;
	if k<0 then k←k+rbase;
	randoms[(i*21)mod 55]←j;
	end;
new_randoms; new_randoms; new_randoms; {``warm up'' the array}
end;
@* The character set.
We need translation tables between ASCII and the actual character
set, in order to make this program portable. The standard conventions of
{\sl \TeX: The Program\/} are copied here, essentially verbatim.

@d text_char == char {the data type of characters in text files}
@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
@d last_text_char=127 {ordinal number of the largest element of |text_char|}

@<Types...@>=
@!ASCII_code=0..127; {seven-bit numbers}

@ @<Glob...@>=
@!xord: array [text_char] of ASCII_code;
	{specifies conversion of input characters}
@!xchr: array [ASCII_code] of text_char;
	{specifies conversion of output characters}

@ @<Set init...@>=
xchr[@'40]←' ';
xchr[@'41]←'!';
xchr[@'42]←'"';
xchr[@'43]←'#';
xchr[@'44]←'$';
xchr[@'45]←'%';
xchr[@'46]←'&';
xchr[@'47]←'''';@/
xchr[@'50]←'(';
xchr[@'51]←')';
xchr[@'52]←'*';
xchr[@'53]←'+';
xchr[@'54]←',';
xchr[@'55]←'-';
xchr[@'56]←'.';
xchr[@'57]←'/';@/
xchr[@'60]←'0';
xchr[@'61]←'1';
xchr[@'62]←'2';
xchr[@'63]←'3';
xchr[@'64]←'4';
xchr[@'65]←'5';
xchr[@'66]←'6';
xchr[@'67]←'7';@/
xchr[@'70]←'8';
xchr[@'71]←'9';
xchr[@'72]←':';
xchr[@'73]←';';
xchr[@'74]←'<';
xchr[@'75]←'=';
xchr[@'76]←'>';
xchr[@'77]←'?';@/
xchr[@'100]←'@@';
xchr[@'101]←'A';
xchr[@'102]←'B';
xchr[@'103]←'C';
xchr[@'104]←'D';
xchr[@'105]←'E';
xchr[@'106]←'F';
xchr[@'107]←'G';@/
xchr[@'110]←'H';
xchr[@'111]←'I';
xchr[@'112]←'J';
xchr[@'113]←'K';
xchr[@'114]←'L';
xchr[@'115]←'M';
xchr[@'116]←'N';
xchr[@'117]←'O';@/
xchr[@'120]←'P';
xchr[@'121]←'Q';
xchr[@'122]←'R';
xchr[@'123]←'S';
xchr[@'124]←'T';
xchr[@'125]←'U';
xchr[@'126]←'V';
xchr[@'127]←'W';@/
xchr[@'130]←'X';
xchr[@'131]←'Y';
xchr[@'132]←'Z';
xchr[@'133]←'[';
xchr[@'134]←'\';
xchr[@'135]←']';
xchr[@'136]←'↑';
xchr[@'137]←'_';@/
xchr[@'140]←'`';
xchr[@'141]←'a';
xchr[@'142]←'b';
xchr[@'143]←'c';
xchr[@'144]←'d';
xchr[@'145]←'e';
xchr[@'146]←'f';
xchr[@'147]←'g';@/
xchr[@'150]←'h';
xchr[@'151]←'i';
xchr[@'152]←'j';
xchr[@'153]←'k';
xchr[@'154]←'l';
xchr[@'155]←'m';
xchr[@'156]←'n';
xchr[@'157]←'o';@/
xchr[@'160]←'p';
xchr[@'161]←'q';
xchr[@'162]←'r';
xchr[@'163]←'s';
xchr[@'164]←'t';
xchr[@'165]←'u';
xchr[@'166]←'v';
xchr[@'167]←'w';@/
xchr[@'170]←'x';
xchr[@'171]←'y';
xchr[@'172]←'z';
xchr[@'173]←'{';
xchr[@'174]←'|';
xchr[@'175]←'}';
xchr[@'176]←'~';@/
xchr[0]←' '; xchr[@'177]←' ';
	{ASCII codes 0 and |@'177| do not appear in text}

@ Some of the ASCII codes without visible characters have been given symbolic
names in this program because they are used with a special meaning.

@d null_code=@'0 {ASCII code that might disappear}
@d carriage_return=@'15 {ASCII code used at end of line}
@d invalid_code=@'177 {ASCII code that should not appear}

@<Set init...@>=
for i←1 to @'37 do xchr[i]←chr(i);
for i←first_text_char to last_text_char do xord[chr(i)]←invalid_code;
for i←1 to @'176 do xord[xchr[i]]←i;
@* Basic input.
Input goes into an array called |buffer|, in a machine-independent form.
If anything goes wrong during an input process, the variable |input_awry|
is set |true| and an error message is printed.

@<Glob...@>=
@!buffer: array[0..buf_size] of ASCII_code; {the current line of input}
@!input_awry: boolean; {has something gone wrong?}

@ Values are read from the buffer by various scanning routines
whose names begin with `\\{get}'. They use the global variable |loc|
to find the current buffer position, as well as the global variable |limit|
which is the smallest unused buffer location.

@<Glob...@>=
@!loc:0..buf_size; {the next character to read is in |buffer[loc]|}
@!limit:0..buf_size; {but if |loc=limit|, the line has been fully read}

@ @<Set init...@>=
input_awry←false; loc←0; limit←0;

@ Here's a procedure that shows the current buffer contents,
using two lines to indicate how many of the characters have been scanned.
It is used only in error messages.

@d input_err(#)==begin print_ln(#,'!'); print_buf; input_awry←true;@+end

@<I/O procedures@>=
procedure print_buf;
var @!k:0..buf_size;
begin if loc>0 then for k←0 to loc-1 do print(xchr[buffer[k]]);
print_ln('');
if loc>0 then for k←0 to loc-1 do print(' ');
if loc<limit then for k←loc to limit-1 do print(xchr[buffer[k]]);
print_ln('');
end;

@ Files are assumed to consist of text only.

@<Types...@>=
@!text_file=packed file of text_char;

@ Input data will be read from |data_file|, which we assume can be
opened by specifying the file name dynamically.
@↑system dependencies@>

@d open_data_file(#)==reset(data_file,#)

@<Glob...@>=
@!data_file:text_file;

@ When all input has been performed on |data_file|, we call `|close_data_file|',
a routine that releases the file for use by others (if our version of
Pascal allows this).
@↑system dependencies@>

@d close_data_file==close(data_file)

@ The |input_ln| procedure brings the next line of input from the
specified file into the |buffer| array. The conventions of \TeX\ are
followed; i.e., |ASCII_code| numbers representing the next line of the
file are input into |buffer[0]|, |buffer[1]|, \dots, |buffer[limit-1]|, and
trailing blanks are ignored. The global variable |limit| is set to the
length of the line, and |loc| is cleared to zero.
The character `\.?' is placed at the end of the line, in case some
scanning routine fetches |buffer[loc]|.

The file should not have ended when |input_ln| is called.
@↑system dependencies@>

@<I/O procedures@>=
procedure input_ln(var@!f:text_file;@!bypass_eoln:boolean); {inputs a line}
var @!final_limit:0..buf_size; {|limit| without trailing blanks}
begin if bypass_eoln then if not eof(f) then get(f);
if eof(f) then input_err('Unexpected end of file')
@.Unexpected end of file@>
else	begin limit←0; final_limit←0; loc←0;
	while not eoln(f) do
		begin buffer[limit]←xord[f↑]; get(f);
		incr(limit);
		if buffer[limit-1]≠" " then final_limit←limit;
		if limit=buf_size then
			begin input_err('Input line too long');
@.Input line too long@>
			while not eoln(f) do get(f);
			end;
		end;
	limit←final_limit; buffer[limit]←"?";
	end;
end;

@ Here's the simplest scanning routine: It returns a single character,
in ASCII code.

@<I/O proc...@>+=
function get_char:ASCII_code;
var @!c:ASCII_code; {the character to return}
begin c←buffer[loc];
if loc<limit then incr(loc)@+else input_err('Input line too short');
@.Input line too short@>
get_char←c;
end;

@ The next simplest scanning routine returns an integer value.

@<I/O proc...@>=
function get_int:integer;
var @!x:integer; {the number to return}
@!loc0:0..buf_size; {initial |loc| setting}
begin loc0←loc; x←0;
while (buffer[loc]≥"0")∧(buffer[loc]≤"9") do
	begin x←10*x+buffer[loc]-"0"; incr(loc);
	end;
if loc=loc0 then input_err('Missing integer');
@.Missing integer@>
get_int←x;
end;

@ Then there's |get_hex|.

@<I/O proc...@>=
function get_hex:integer;
label not_found,exit;
var @!x:integer;
begin x←get_char;
if x<"0" then goto not_found;
if x≤"9" then x←x-"0"
else	begin if x<"A" then goto not_found;
	if x≤"F" then x←x-"A"+10
	else	begin if x<"a" then goto not_found;
		if x>"f" then goto not_found;
		x←x-"a"+10;
		end;
	end;
get_hex←x; return;
not_found: input_err('Bad hex digit'); get_hex←0;
exit: end;
@* Reading the ant data.
The instructions are kept in four arrays |template|, |mask|, |action|,
|next|; their symbolic names go in |symb1..symb4|.
Scent codes go into |scent_code|. The input format is very primitive.

@<Glob...@>=
@!symb1,@!symb2,@!symb3,@!symb4:array[0..1024] of ASCII_code;
@!template,@!mask:array[0..1024] of set of inputs;
@!action:array[0..1024] of set of acts;
@!next:array[0..1024] of 0..1023;
@!scent_code:array[0..15] of ASCII_code;

@ @<Types...@>=
@!inputs=(@!ant,@!barrier,@!food,@!rand,@!s1,@!s2,@!s3,@!s4);
@!acts=(@!ds1,@!ds2,@!ds3,@!ds4,@!mm,@!pp);

@ @<Clear the instructions to zero@>=
for i←0 to 1024 do
	begin symb1[i]←" "; symb2[i]←" "; symb3[i]←" "; symb4[i]←" ";
	template[i]←[]; mask[i]←[]; action[i]←[]; next[i]←0;
	end

@ Most of the input consists of individual instruction lines.

@<I/O...@>=
procedure get_inst(i:integer);
label exit;
var x,y:integer;
t:inputs;
a:acts;
begin @<Read the template part of a line@>;
if input_awry then return;
@<Read the action part of a line@>;
if input_awry then return;
if loc<limit then x←get_char;
if loc<limit then symb1[i]←get_char else symb1[i]←" ";
if loc<limit then symb2[i]←get_char else symb2[i]←" ";
if loc<limit then symb3[i]←get_char else symb3[i]←" ";
if loc<limit then symb4[i]←get_char else symb4[i]←" ";
exit:end;

@ @<Read the template part of a line@>=
x←get_hex*16+get_hex; y←get_hex*16+get_hex;
for t←s4 downto ant do
	begin if odd(x) then template[i]←template[i]+[t];
	if odd(y) then mask[i]←mask[i]+[t];
	x←x div 2; y←y div 2;
	end

@ @<Read the action part of a line@>=
x←get_hex*16+get_hex; next[i]←((x mod 4)*16+get_hex)*16+get_hex;
x←x div 4;
for a←pp downto ds1 do
	begin if odd(x) then action[i]←action[i]+[a];
	x←x div 2;
	end

@ The function |read_ant| returns |false| if any anomaly is detected.

@<I/O...@>= 
function read_ant:boolean;
label not_found,found,exit;
var i:integer;
begin open_data_file('ANT.DAT');
input_ln(data_file,false);
input_ln(data_file,true); {ignore the first (name) line}
for i←0 to 15 do if not input_awry then scent_code[i]←get_char;
if input_awry then goto not_found;
@<Clear the instructions to zero@>;
i←0;
loop	begin input_ln(data_file,true);
	if input_awry then goto not_found;
	if buffer[0]="*" then goto found;
	get_inst(i); incr(i);
	if input_awry then goto not_found;
	end;
found: read_ant←true; return;
not_found: read_ant←false;
exit:close_data_file;
end;
@* The playing field.
The ants can move in an $m\times n$ field surrounded by barriers, where
|m<max_m| and |n<max_n|.
Each cell of the field is represented by several array entries.

@d up_ant=0 {code for ant facing up}
@d left_ant=1 {code for ant facing left}
@d down_ant=2 {code for ant facing down}
@d right_ant=3 {code for ant facing right}
@d empty=4 {code for empty cell}
@d barr=5 {code for barrier cell}
@d nest=10 {code for food units in a nest cell}

@<Glob...@>=
@!cell_type:array[0..max_m,0..max_n] of 0..5; {contents of cell}
@!cell_loc:array[0..max_m,0..max_n] of integer; {ant state}
@!ant_full:array[0..max_m,0..max_n] of boolean; {does the ant carry food?}
@!cell_food:array[0..max_m,0..max_n] of 0..nest; {number of food bits}
@!cell_scent:array[0..max_m,0..max_n] of set of inputs; {scent of cell}
@!init_cell_food:array[0..max_m,0..max_n] of 0..nest; {initial number of food bits}
@!m,@!n:integer; {size of field}
@!tot_food:integer; {number of bits of food outside the nest}
@!seed:integer; {initial value for the random number generator}

@ We read the initial board thus:

@<I/O...@>=
function read_board:boolean;
label not_found,found,exit;
var i,j:integer;
begin open_data_file('FIELD.DAT');
input_ln(data_file,false);
m←get_int;
if m≥max_m then input_err('m too large');
if get_char≠" " then input_err('Missing blank')
else	begin n←get_int; if n≥max_n then input_err('n too large');
	end;
if input_awry then goto not_found;
@<Put a barrier around the field@>;
for i←1 to m do
	begin input_ln(data_file,true);
	if input_awry then goto not_found;
	for j←1 to n do case get_char of
		".":begin cell_type[i,j]←empty; init_cell_food[i,j]←0; cell_loc[i,j]←0;
			end;
		"1","2","3","4","5","6","7","8","9":begin cell_type[i,j]←empty;
			init_cell_food[i,j]←buffer[loc-1]-"0";
			end;
		"B":begin cell_type[i,j]←barr;init_cell_food[i,j]←0;
			end;
		"N":begin cell_type[i,j]←up_ant; init_cell_food[i,j]←nest;
			cell_loc[i,j]←0;
			end;
		othercases input_err('Unknown field code')
		endcases;
	if input_awry then goto not_found;
	end;
found: read_board←true; return;
not_found: read_board←false;
exit:close_data_file;
end;

@ @<Put a barrier around the field@>=
for i←1 to m do
	begin cell_type[i,0]←barr; cell_food[i,0]←0;
	cell_type[i,n+1]←barr; cell_food[i,n+1]←0;
	end;
for j←1 to n do
	begin cell_type[0,j]←barr; cell_food[0,j]←0;
	cell_type[m+1,j]←barr; cell_food[m+1,j]←0;
	end

@ The board is actually initialized as follows:

@<Special...@>=
procedure init_board;
var i,j:integer;
begin tot_food←0; init_randoms(seed);
for i←1 to m do for j←1 to n do
	begin cell_food[i,j]←init_cell_food[i,j];
	if cell_food[i,j]>9 then
		begin cell_type[i,j]←up_ant; cell_loc[i,j]←0;
		end
	else if cell_type[i,j]<barr then
		begin cell_type[i,j]←empty; tot_food←tot_food+cell_food[i,j];
		end;
	ant_full[i,j]←false; cell_scent[i,j]←[]; move_loc[i,j]←0;
	end;
end;

@ Here's a procedure that will display the current board.

@<Special...@>=
procedure print_board;
label done;
var i,j,l,sc:integer;
begin for i←1 to m do
	begin for j←1 to n do @<Print first line for |cell[i,j]|@>;
	print_ln('');
        if time<50 then
		begin for j←1 to n do @<Print second line for |cell[i,j]|@>;
		print_ln('');
		end;
	end;
end;

@ @<Print first...@>=
begin if ant_full[i,j] then print('⊗')@+ else print(' ');
case cell_type[i,j] of
up_ant: print('↑');
left_ant: print('←');
down_ant: print('↓');
right_ant: print('→');
empty: print('.');
barr: begin print('BBB'); goto done;
	end;
endcases;
@<Print the scent of |cell[i,j]|@>;
if cell_food[i,j]=0 then print('.')
else if cell_food[i,j]>9 then print('∞')
else print(cell_food[i,j]:1);
done:end

@ @<Print the scent of |cell[i,j]|@>=
if s1 in cell_scent[i,j] then sc←8@+else sc←0;
if s2 in cell_scent[i,j] then sc←sc+4;
if s3 in cell_scent[i,j] then sc←sc+2;
if s4 in cell_scent[i,j] then sc←sc+1;
print(xchr[scent_code[sc]])

@ @<Print second...@>=
case cell_type[i,j] of
up_ant,left_ant,down_ant,right_ant:begin l←cell_loc[i,j];
	print(xchr[symb1[l]]);
	print(xchr[symb2[l]]);
	print(xchr[symb3[l]]);
	print(xchr[symb4[l]]);
	end;
empty:print(' ...');
barr: print(' BBB');
endcases
@* Moves.
The main action at each unit of time is defined by the |move| routine.

@<Special...@>=
procedure move;
label done,continue,not_found;
var@!i,@!ii,@,j,@!jj,@!l:integer;
@!s:inputs;
@!t,@!tt:set of inputs;
@!ds:acts;
@!p:integer; {top of stack of logged moves}
@!q:integer; {packed version of |[ii,jj]|}
begin p←0;
for i←1 to m do for j←1 to n do if cell_type[i,j]<empty then
	begin @<Compute the input bits@>;
	@<Find the matching instruction@>;
	@<Do or log the specified action@>;
	end;
@<Do all logged moves@>;
end;

@ Moves are ``logged'' (to be done later) by putting |max_n*i+j| in
|move_loc[ii,jj]| when we wish to move from |[i,j]| to |[ii,jj]|. A pointer
to another logged move, if any, goes in |move_link[ii,jj]|.

@<Glob...@>=
@!move_loc:array[0..max_m,0..max_n] of integer; {I'll move from here}
@!move_link:array[0..max_m,0..max_n] of integer; {stack link}

@ @<Compute the input bits@>=
case cell_type[i,j] of
up_ant: begin ii←i-1; jj←j;@+end;
left_ant: begin ii←i; jj←j-1;@+end;
right_ant: begin ii←i; jj←j+1;@+end;
down_ant: begin ii←i+1; jj←j;@+end;
endcases;
if cell_food[ii,jj]>0 then t←[food]@+else t←[];
case cell_type[ii,jj] of
up_ant,left_ant,right_ant,down_ant:begin t←t+[ant];
	if ant_full[ii,jj] then t←t+[barrier];
	end;
empty:do_nothing;
barr:t←t+[barrier];
endcases;
if random_bit then t←t+[rand];
if cell_food[ii,jj]<nest then for s←s1 to s4 do
 if s in cell_scent[ii,jj] then t←t+[s]

@ @<Find the matching instruction@>=
l←cell_loc[i,j];
loop	begin tt←(t-template[l])+(template[l]-t);
	if tt*mask[l]=[] then goto done;
	incr(l);
	end;
done:

@ @d delta(#)==if d@&# in action[l] then
	begin if # in cell_scent[i,j] then cell_scent[i,j]←cell_scent[i,j]-[#]
	else cell_scent[i,j]←cell_scent[i,j]+[#];
	end

@<Do or log the specified action@>=
if mm in action[l] then
	if pp in action[l] then @<Log a move and |goto continue|@>
	else cell_type[i,j]←(cell_type[i,j]+1) mod 4 {left turn}
else if pp in action[l] then cell_type[i,j]←(cell_type[i,j]+3) mod 4; {right turn}
delta(s1); delta(s2); delta(s3); delta(s4);
cell_loc[i,j]←next[l];
continue:

@ @<Log...@>=
begin if cell_type[ii,jj]≠empty then if cell_food[ii,jj]<nest then goto not_found;
if move_loc[ii,jj]>0 then goto not_found;
move_loc[ii,jj]←i*max_n+j; move_link[ii,jj]←p;
p←ii*max_n+jj; cell_loc[i,j]←l;
goto continue;
not_found: if next[l]=0 then cell_loc[i,j]←1024@+else cell_loc[i,j]←next[l]-1;
goto continue;
end

@ @<Do all logged moves@>=
while p>0 do
	begin ii←p div max_n; jj←p mod max_n;@/
	i←move_loc[ii,jj] div max_n; j←move_loc[ii,jj] mod max_n;@/
	l←cell_loc[i,j]; @<Update cell |ii,jj|@>;
	if cell_food[i,j]<nest then
		begin cell_type[i,j]←empty; ant_full[i,j]←false;
		end
	else	begin cell_type[i,j]←up_ant; cell_loc[i,j]←0;
		end;
	p←move_link[ii,jj]; move_loc[ii,jj]←0;
	end

@ @d ddelta(#)==if d@&# in action[l] then
	begin if # in cell_scent[ii,jj] then cell_scent[ii,jj]←cell_scent[ii,jj]-[#]
	else cell_scent[ii,jj]←cell_scent[ii,jj]+[#];
	end

@<Update cell...@>=
begin ddelta(s1); ddelta(s2); ddelta(s3); ddelta(s4);
if cell_food[ii,jj]=nest then
	begin if ant_full[i,j] then tot_food←tot_food-1;
	end
else	begin cell_type[ii,jj]←cell_type[i,j];
	if ant_full[i,j] then ant_full[ii,jj]←true
	else if cell_food[ii,jj]>0 then
		begin ant_full[ii,jj]←true; decr(cell_food[ii,jj]);
		end
	else ant_full[ii,jj]←false;
	cell_loc[ii,jj]←next[l];
	end;
end
@* The main program.
(temporary, I keep hacking at this)

@<The main...@>=
seed←0;
if read_ant then if read_board then
 loop	begin incr(seed); time←0;
	init_board; if seed=1 then print_board;
	while tot_food>0 do
		begin if seed=1 then
			print_ln('**************************** time=',time:1,@|
				' food remaining=',tot_food:1);@/
		move; incr(time); if seed=1 then print_board;
		end;
	print_ln('======================================= time=',time:1);
	end;
final_end:

@ @<Glob...@>=
@!time:integer;
@* Index.
Here are the quantities declared and/or used in the program.
(The uses of single-letter variables aren't indexed.)